home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The Original Shareware 1.1
/
The Original Shareware (WeMake CDs)(Volume 1.1)(CDs, Inc)(1993).iso
/
16
/
columns2.zip
/
COLUMNS.BAS
next >
Wrap
BASIC Source File
|
1986-03-25
|
15KB
|
551 lines
101 ' ========================================================
102 '
103 ' Columns is a program that will re-assemble a text file
104 ' into columns either on printer or disk. The original
105 ' code for the program was written by Steve Rimmer, of
106 ' COMPUTING NOW! magazine for an article in the March,
107 ' 1986 issue. Rimmer's code was reworked and fancied
108 ' up by Brian Hillis, to provide more friendliness and
109 ' flexibility.
110 '
111 ' If you have any comments and/or suggestions, please
112 ' contact:
113 '
114 ' Brian Hillis
115 ' 240 Scarlett Rd.
116 ' Suite 313
117 ' Toronto, Ontario
118 ' M6N 4X4
119 ' Canada
120 ' (416) 769-2251
121 '
122 ' ========================================================
123 '
124 DEFINT A-Z
125 DIM GA$(255),HL$(5),FL$(5)
126 '
127 ' This routine checks to see if you are using a color or
128 ' monochrome monitor. It is important to know which you
129 ' are using in order to set the correct display atributes.
130 '
131 DEF SEG=0
132 M=PEEK(1040) AND 48
133 IF M=48 THEN SCR=0:L=&HB000:GOTO 136
134 SCR=1
135 L=&HB800
136 DEF SEG=L
137 IF SCR=0 THEN TA=7:TB=8:TC=24:TD=16:BA=0:BB=1
138 IF SCR=1 THEN TA=7:TB=7:TC=7:TD=7:BA=0:BB=0
139 '
140 ' Now we have to declare a few values for various flags,
141 ' displays, and input routines.
142 '
143 FALSE=0
144 TRUE=NOT FALSE
145 ESC$=CHR$(27)
146 LO$="abcdefghijklmnopqrstuvwxyz"
147 UP$="ABCDEFGHIJKLMNOPQRSTUVWXYZ"
148 NU$="0123456789"
149 FF=TRUE
150 WIDTH "LPT1:",175
151 RU$="----+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8----+----9----+----0----+----1----+----2----+----3----+"
152 '
153 ' This takes us to the opening screen and menu selections
154 ' needed to set up the program.
155 '
156 GOSUB 382
157 TA=5
158 '
159 ' This is where COLUMNS starts figuring out how much data
160 ' to put on each line, based on the information you
161 ' entered during the initial menu selection. COLUMNS will
162 ' also give you a running display on the top line of your
163 ' screen to let you know the status of its work.
164 '
165 GOSUB 225
166 '
167 ' This is the end of the program.
168 '
169 SCREEN 0
170 WIDTH 80
171 LOCATE,,1
172 CLS
173 END
174 '
175 ' This is the keyboard input routine. It checks to make
176 ' your input qualifies as the type of input expected. In
177 ' other words, if COLUMNS is expecting a number, it won't
178 ' let you enter an alpha character.
179 '
180 LOCATE,,1
181 C$=""
182 B$=""
183 '
184 ' Accept input as long as it's not a carriage return.
185 '
186 WHILE B$<>CHR$(13)
187 '
188 ' Look for input from the keyboard
189 '
190 B$=INPUT$(1)
191 '
192 ' if the input is not one of the eligible characters,
193 ' go back and wait for another one.
194 '
195 IF INSTR(M$+CHR$(8)+CHR$(13),B$)=0 THEN 190
196 '
197 ' These lines deal with the DELETE key.
198 '
199 IF B$=CHR$(8) AND LEN(C$)<1 THEN 190
200 IF B$=CHR$(8) THEN PRINT CHR$(29);" ";CHR$(29);:C$=LEFT$(C$,LEN(C$)-1):GOTO 190
201 '
202 ' If it's an eligible character, and NOT a carriage
203 ' return, then print it on the screen and save it
204 ' on the end of the variable C$. Then go back and wait
205 ' for another input.
206 '
207 IF B$<>CHR$(13) AND LEN(C$)<ENT THEN C$=C$+B$:PRINT B$;
208 WEND
209 '
210 ' When we finally get a carriage return, chop it off
211 ' the end, and send C$ back to where it's needed.
212 '
213 IF RIGHT$(C$,1)=CHR$(13) THEN C$=LEFT$(C$,LEN(C$)-1)
214 LOCATE,,0
215 RETURN
216 '
217 ' This is where COLUMNS figures out how wide to make each
218 ' column, how many lines to a page, and some other fancy
219 ' stuff. First the number of column lines is calculated
220 ' and stored in GD. Then the page number is calculated
221 ' and converted to a string (it's easier to deal with at
222 ' printing time). Finally the array containing the lines
223 ' of text is cleared.
224 '
225 GD=PC*(PD-H-F-AF-2)
226 PN=PN+1
227 PN$=RIGHT$(STR$(PN),LEN(STR$(PN))-1)
228 FOR X=1 TO 255
229 GA$(X)=""
230 NEXT X
231 PS=0
232 PD=PDD
233 '
234 ' Now COLUMNS goes into your text file and starts
235 ' gathering characters to make up the column lines.
236 '
237 FOR X=1 TO GD
238 GOSUB 339
239 GA$(X)=T$
240 IF NOT FF THEN X=GD
241 '
242 ' While COLUMNS is assembling lines of text, it keeps you
243 ' informed of its progress.
244 '
245 LOCATE 1,1,0
246 PRINT "Assembling Page ";
247 COLOR TB,BB
248 PRINT PN$;
249 COLOR TA,BA
250 X$=RIGHT$(STR$(X),LEN(STR$(X))-1)
251 LOCATE 1,20,0
252 PRINT "- Line ";
253 COLOR TB,BB
254 PRINT X$;
255 COLOR TA,BA
256 PRINT " "
257 FLN$=RIGHT$(STR$(FLN!),LEN(STR$(FLN!))-1)
258 LOCATE 1,40,0
259 COLOR TB,BB
260 PRINT FLN$;
261 COLOR TA,BA
262 PRINT " Bytes Remaining. "
263 '
264 ' If you asked COLUMNS to display the assembly process
265 ' this is where it happens. It will display 21 new lines
266 ' then start scrolling. It's slow writing to the screen
267 ' but it's worth looking at if you think there might be
268 ' a problem with the assembly.
269 '
270 LOCATE 3,1,0
271 IF X<20 THEN Y=1 ELSE Y=X-20
272 FOR Z=Y TO X
273 IF D=1 THEN PRINT GA$(Z);"|"
274 NEXT Z
275 NEXT X
276 '
277 ' This is where COLUMNS prints your new file either to
278 ' your printer or disk, depending on what you specified
279 ' during the opening selections. If it prints to disk
280 ' it will create a new file on the CURRENT directory of
281 ' the drive that contained the original text file. Each
282 ' new page is named PAGE-1, PAGE-2, etc.
283 '
284 IF NOT PF THEN OPEN "O",#2,DR$+"PAGE-"+PN$ ELSE OPEN "LPT1:" AS 2
285 '
286 ' Print the correct printer codes.
287 '
288 PRINT #2,PI$;
289 '
290 ' Calculate how much of the page is available for
291 ' text lines.
292 '
293 PS=H+1
294 PF=F+1
295 PD=PD-PS-PF
296 '
297 ' If there are header lines, then print them. Otherwise,
298 ' skip to the next part.
299 '
300 IF H<1 THEN 309
301 FOR X=1 TO H
302 PRINT #2,HL$(X);CHR$(13);CHR$(10);
303 NEXT
304 PRINT #2,CHR$(13);CHR$(10);
305 '
306 ' Start printing the correct column lines side by side
307 ' on the same line.
308 '
309 FOR X=1 TO PD
310 FOR Y=1 TO PC
311 PRINT #2,GA$(X+(PD*(Y-1)));
312 IF Y<PC THEN PRINT #2,SPACE$(PG);
313 NEXT Y
314 PRINT #2,CHR$(13);CHR$(10);
315 NEXT X
316 PRINT #2,CHR$(13);CHR$(10);
317 '
318 ' If no footer line has been specified, print the
319 ' page number at the bottom of the page. Otherwise,
320 ' print the footer lines.
321 '
322 IF F>0 THEN 323 ELSE PRINT #2,SPACE$((PW-10)/2) "- Page "PN$" -"
323 PRINT
324 FOR X=1 TO F
325 PRINT #2,FL$(X);CHR$(13);CHR$(10);
326 NEXT
327 PRINT #2,CHR$(12);
328 CLOSE #2
329 '
330 ' If there is still anything left in the original text
331 ' file, start assembling another page.
332 '
333 IF FF THEN 226
334 RETURN
335 '
336 ' This is where COLUMNS goes into your source file and
337 ' starts assembling new lines of text.
338 '
339 GW=INT(((PW-PC)/PC)-((PC-1)*PG/PC))
340 B=0
341 L=0
342 T$=H$
343 WHILE (B<>&HD) AND (B<>&H8D) AND (L<=GW) AND FF
344 IF EOF(1) THEN FF=FALSE:GOTO 343
345 B$=INPUT$(1,1)
346 B=ASC(B$)
347 FLN!=FLN!-1
348 IF FLN!>0 THEN FF=TRUE
349 '
350 ' Just in case your source file was created in WORDSTAR,
351 ' COLUMNS will correct all the high bits to make it read
352 ' properly.
353 '
354 GOSUB 372
355 T$=T$+B$
356 L=LEN(T$)
357 IF B$<>"" THEN P=ASC(B$)
358 WEND
359 B$=""
360 H$=""
361 WHILE B$<>" " AND L>0
362 B$=MID$(T$,L,1)
363 IF B$<>" " THEN H$=B$+H$:MID$(T$,L,1)=" ":L=L-1
364 WEND
365 IF H$=" " THEN H$=""
366 IF LEFT$(T$,1)="." THEN 339
367 RETURN
368 '
369 ' This is the routine to convert WORDSTAR characters
370 ' to normal ASCII characters.
371 '
372 IF (L=0) AND (B=32) THEN B$=""
373 IF B=&HA0 THEN B$=""
374 IF (B=&H8D) AND (P<>32) THEN B$=" ":B=0
375 IF (B=&H8D) AND (P=32) THEN B$="":B=0
376 IF B>127 THEN B=B-128
377 IF B<32 THEN B$=""
378 IF B=9 THEN B$=SPACE$(TA)
379 IF B=13 THEN B$=SPACE$(1+(GW-L))
380 IF B=>32 THEN B$=CHR$(B)
381 RETURN
382 CLS
383 KEY OFF
384 COLOR TB,BB
385 LOCATE 1,1
386 PRINT CHR$(201);
387 PRINT STRING$(77,205);
388 PRINT CHR$(187)
389 FOR X=2 TO 8
390 LOCATE X,1
391 PRINT CHR$(186)
392 LOCATE X,79
393 PRINT CHR$(186)
394 NEXT
395 '
396 ' This is the start of the opening menu selections
397 ' where you set the number of columns, printer type,
398 ' headers, footer, etc.
399 '
400 ' Defaults are: Star/IBM Printer
401 ' Condensed print
402 ' 2 columns, 8 character gutter
403 ' 60 lines per page
404 ' No screen display
405 ' Print new file to disk
406 ' No header lines
407 ' One footer line with the page number
408 '
409 PRINT CHR$(200);
410 PRINT STRING$(77,205);
411 PRINT CHR$(188)
412 COLOR TA,BA
413 LOCATE 3,20
414 COLOR TB,BB
415 PRINT "Print Text Files In COLUMNS - Version 2.0"
416 COLOR TA,BA
417 LOCATE 5,5
418 PRINT "This program was originally written by Steve Rimmer of Computing Now"
419 LOCATE 6,5
420 PRINT "Magazine (March 1986 issue), and modified for flexibility and compiled"
421 LOCATE 7,5
422 PRINT "by Brian Hillis. If you have any comments phone (416) 769-2251."
423 FOR D=1 TO 2000
424 NEXT D
425 LOCATE 11,20
426 PRINT "Which ";
427 COLOR TB,BB
428 PRINT "printer";
429 COLOR TA,BA
430 PRINT " are you using?"
431 LOCATE 12,20
432 PRINT "<";
433 COLOR TB,BB
434 PRINT "G";
435 COLOR TA,BA
436 PRINT ">emini-10 <";
437 COLOR TB,BB
438 PRINT "O";
439 COLOR TA,BA
440 PRINT ">kidata <";
441 COLOR TB,BB
442 PRINT "S";
443 COLOR TA,BA
444 PRINT ">tar-IBM"
445 LOCATE 13,20
446 PRINT "<";
447 COLOR TB,BB
448 PRINT "T";
449 COLOR TA,BA
450 PRINT ">i-855 S";CHR$(29);
451 M$="GSOTgsot"
452 ENT=1
453 GOSUB 180
454 IF LEN(C$)<1 THEN C$="S"
455 IF C$="G" OR C$="g" THEN PR=1
456 IF C$="O" OR C$="o" THEN PR=2
457 IF C$="S" OR C$="s" THEN PR=3
458 IF C$="T" OR C$="t" THEN PR=4
459 LOCATE 15,20
460 PRINT "Which print ";
461 COLOR TB,BB
462 PRINT "pitch";
463 COLOR TA,BA
464 PRINT " do you require?"
465 LOCATE 16,20
466 PRINT "<";
467 COLOR TB,BB
468 PRINT "C";
469 COLOR TA,BA
470 PRINT ">ondensed-17cpi <";
471 COLOR TB,BB
472 PRINT "E";
473 COLOR TA,BA
474 PRINT ">lite-12cpi"
475 LOCATE 17,20
476 PRINT "<";
477 COLOR TB,BB
478 PRINT "P";
479 COLOR TA,BA
480 PRINT ">ica-10cpi C";CHR$(29);
481 M$="CEPcep"
482 ENT=1
483 GOSUB 180
484 IF LEN(C$)<1 THEN C$="C"
485 IF C$="C" OR C$="c" AND PR=1 THEN PW=132:PI$=ESC$+CHR$(66)+CHR$(3)
486 IF C$="E" OR C$="e" AND PR=1 THEN PW=96:PI$=ESC$+CHR$(66)+CHR$(2)
487 IF C$="P" OR C$="p" AND PR=1 THEN PW=80:PI$=ESC$+CHR$(66)+CHR$(1)
488 IF C$="C" OR C$="c" AND PR=2 THEN PW=132:PI$=CHR$(29)
489 IF C$="E" OR C$="e" AND PR=2 THEN PW=96:PI$=CHR$(28)
490 IF C$="P" OR C$="p" AND PR=2 THEN PW=80:PI$=CHR$(30)
491 IF C$="C" OR C$="c" AND PR=3 THEN PW=132:PI$=ESC$+CHR$(15)
492 IF C$="E" OR C$="e" AND PR=3 THEN PW=96:PI$=ESC$+CHR$(77)
493 IF C$="P" OR C$="p" AND PR=3 THEN PW=80:PI$=ESC$+CHR$(80)
494 IF C$="C" OR C$="c" AND PR=4 THEN PW=132:PI$=CHR$(15)
495 IF C$="E" OR C$="e" AND PR=4 THEN PW=96:PI$=ESC$+CHR$(122)
496 IF C$="P" OR C$="p" AND PR=4 THEN PW=80:PI$=ESC$+CHR$(121)
497 LOCATE 18,20
498 PRINT "How many ";
499 COLOR TB,BB
500 PRINT "columns";
501 COLOR TA,BA
502 PRINT " across the page? 2";CHR$(29);
503 M$=NU$
504 ENT=1
505 GOSUB 180
506 IF LEN(C$)<1 THEN PC=2 ELSE PC=VAL(C$)
507 LOCATE 19,20
508 PRINT "How many ";
509 COLOR TB,BB
510 PRINT "spaces";
511 COLOR TA,BA
512 PRINT " between columns? 8";CHR$(29);
513 M$=NU$
514 ENT=2
515 GOSUB 180
516 IF LEN(C$)<1 THEN PG=8 ELSE PG=VAL(C$)-1
517 LOCATE 20,20
518 PRINT "How many ";
519 COLOR TB,BB
520 PRINT "lines";
521 COLOR TA,BA
522 PRINT " per page? 60";CHR$(29);CHR$(29);
523 M$=NU$
524 ENT=2
525 GOSUB 180
526 IF LEN(C$)<1 THEN PD=60 ELSE PD=VAL(C$)
527 PDD=PD
528 LOCATE 21,20
529 COLOR TB,BB
530 PRINT "Display";
531 COLOR TA,BA
532 PRINT " assembly on screen? ";
533 COLOR TB,BB
534 PRINT "Y";
535 COLOR TA,BA
536 PRINT " or ";
537 COLOR TB,BB
538 PRINT "N";
539 COLOR TA,BA
540 PRINT " N";CHR$(29);
541 M$="YNyn"
542 ENT=1
543 GOSUB 180
544 IF LEN(C$)<1 THEN C$="N"
545 IF C$="Y" OR C$="y" THEN D=1 ELSE D=0
546 LOCATE 22,20
547 COLOR TB,BB
548 PRINT "Output";
549 COLOR TA,BA
550 PRINT " to <";
551 COLOR TB,BB
552 PRINT "P";
553 COLOR TA,BA
554 PRINT ">rinter or <";
555 COLOR TB,BB
556 PRINT "D";
557 COLOR TA,BA
558 PRINT ">isk D";CHR$(29);
559 M$="PDpd"
560 ENT=1
561 GOSUB 180
562 IF LEN(C$)<1 THEN PF=FALSE
563 IF C$="P" OR C$="p" THEN PF=TRUE ELSE PF=FALSE
564 LOCATE 23,20
565 PRINT "Number of ";
566 COLOR TB,BB
567 PRINT "HEADER";
568 COLOR TA,BA
569 PRINT " lines (";
570 COLOR TB,BB
571 PRINT "1";
572 COLOR TA,BA
573 PRINT " to ";
574 COLOR TB,BB
575 PRINT "5";
576 COLOR TA,BA
577 PRINT ") 0";CHR$(29);
578 M$=MID$(NU$,2,5)
579 ENT=1
580 GOSUB 180
581 IF LEN(C$)<1 THEN H=0 ELSE H=VAL(C$)
582 LOCATE 24,20
583 PRINT "Number of ";
584 COLOR TB,BB
585 PRINT "FOOTER";
586 COLOR TA,BA
587 PRINT " lines (";
588 COLOR TB,BB
589 PRINT "1";
590 COLOR TA,BA
591 PRINT " to ";
592 COLOR TB,BB
593 PRINT "5";
594 COLOR TA,BA
595 PRINT ") 0";CHR$(29);
596 M$=MID$(NU$,2,5)
597 ENT=1
598 GOSUB 180
599 IF LEN(C$)<1 THEN F=0 ELSE F=VAL(C$)
600 IF F=0 THEN AF=3 ELSE AF=0
601 IF H=0 AND F=0 THEN 636
602 IF H=0 THEN 620
603 CLS
604 LOCATE 1,1
605 PRINT "Header lines... Type each complete header line then press [ENTER]"
606 LOCATE 3,1
607 COLOR TB,BB
608 PRINT LEFT$(RU$,PW)
609 COLOR TA,BA
610 PRINT
611 FOR X=1 TO H
612 M$=UP$+LO$+NU$+"-_./\=+* "
613 ENT=PW
614 GOSUB 180
615 IF LEN(C$)<1 THEN C$=" "
616 HL$(X)=C$
617 PRINT
618 NEXT
619 IF F=0 THEN 636
620 CLS
621 LOCATE 1,1
622 PRINT "Footer lines... Type each complete footer line then press [ENTER]"
623 LOCATE 3,1
624 COLOR TB,BB
625 PRINT LEFT$(RU$,PW)
626 COLOR TA,BA
627 PRINT
628 FOR X=1 TO F
629 M$=UP$+LO$+NU$+"-_./\=+* "
630 ENT=PW
631 GOSUB 180
632 IF LEN(C$)<1 THEN C$=" "
633 FL$(X)=C$
634 PRINT
635 NEXT
636 CLS
637 LOCATE 1,1
638 PRINT "Name of ";
639 COLOR TB,BB
640 PRINT "source";
641 COLOR TA,BA
642 PRINT " file (Path is OK): ";
643 M$=UP$+LO$+NU$+" .\:"
644 ENT=32
645 GOSUB 180
646 IF LEN(C$)<1 THEN 169 ELSE OPEN "I",#1,C$
647 FLN!=LOF(1)
648 IF MID$(C$,2,1)=":" THEN DR$=LEFT$(C$,2) ELSE DR$=""
649 CLS
650 RETURN